Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/random/frmrand.frm

Text File | 1995-05-02 | 8KB | 295 lines

VERSION 2.00
Begin Form Random
   BackColor       =   &H00C0C0C0&
   Caption         =   "Random Number Generator"
   ClientHeight    =   4020
   ClientLeft      =   1965
   ClientTop       =   1620
   ClientWidth     =   4590
   Height          =   4425
   Left            =   1905
   LinkTopic       =   "Form1"
   ScaleHeight     =   4020
   ScaleWidth      =   4590
   Top             =   1275
   Width           =   4710
   Begin TextBox txtValue
      Height          =   285
      Left            =   2580
      TabIndex        =   1
      Top             =   660
      Width           =   1095
   End
   Begin TextBox txtMin
      Height          =   285
      Left            =   2580
      TabIndex        =   2
      Top             =   1860
      Width           =   1095
   End
   Begin TextBox txtMax
      Height          =   285
      Left            =   2580
      TabIndex        =   3
      Top             =   2460
      Width           =   1095
   End
   Begin CommandButton cmdGenerate
      Caption         =   "&Generate"
      Height          =   375
      Left            =   1680
      TabIndex        =   4
      Top             =   3360
      Width           =   1335
   End
   Begin Shape Shape1
      Height          =   2775
      Left            =   480
      Top             =   300
      Width           =   3615
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Number of Values"
      Height          =   375
      Left            =   900
      TabIndex        =   0
      Top             =   660
      Width           =   1335
   End
   Begin Label Label2
      BackColor       =   &H00C0C0C0&
      Caption         =   "Minimum Value"
      Height          =   375
      Left            =   900
      TabIndex        =   5
      Top             =   1860
      Width           =   1335
   End
   Begin Label Label3
      BackColor       =   &H00C0C0C0&
      Caption         =   "Maximum Value"
      Height          =   375
      Left            =   900
      TabIndex        =   6
      Top             =   2460
      Width           =   1335
   End
End
Option Explicit
    Dim sMsg As String

Sub cmdGenerate_Click ()

    'Install error handler

    On Error GoTo UnexpectedOops

    'Test for valid range

    If Val(TxtMax.Text) <= Val(TxtValue.Text) + Val(TxtMin.Text) Then
        TxtMax.SetFocus
        sMsg = "Range must be larger than the number of values generated."
        MsgBox sMsg, 64, "Error"
        sMsg = ""
        Exit Sub
    End If

    ReDim numbers(1 To TxtValue.Text) As Integer
    Dim I As Integer, n As Integer, temp As Integer

    Randomize       ' seed random number generator

    I = 1

    Do
                    ' generate random number between Min and Max
        temp = Int(Rnd(1) * ((TxtMax.Text - TxtMin.Text) + 1) + TxtMin.Text)

        If I = 1 Then  ' don't test if first number (will be = to itself)
            numbers(I) = temp
            I = I + 1
        Else
            For n = 1 To I - 1
                If numbers(n) = temp Then   ' check all numbers for duplicates
                    Exit For
                End If
            Next n
            If numbers(n) <> temp Then      ' temp is unique
                numbers(I) = temp
                I = I + 1                   ' advance counter
            Else
                ' do nothing, don't save temp to numbers() and
                ' don't advance I.
                ' go through loop again to search for a unique number
            End If
        End If

Loop While I <= TxtValue.Text       ' repeat until you have enough unique numbers

    ' Generate message box to display numbers

For I = 1 To UBound(numbers)
    sMsg = sMsg + Str$(numbers(I)) & ", "
Next I
MsgBox sMsg, 64, "Unique Random Numbers"
sMsg = ""
Exit Sub

UnexpectedOops:

    MsgBox Error$(Err)
    Exit Sub


End Sub

Sub DrawFrame (TargetControl As Control, FrameWidth, FrameStyle)


' Function: Draw a 3D outline around a control.
' Syntax: DrawFrame Control, Width, Style
' Control = name of control the outline should
'           be drawn around
' Width   = width of the outline
' Style   = Raised or Sunken look
'           0 = Raised
'           1 = Sunken

' Example: DrawFrame Text1, 2, 1

' gives a sunken 3D look to text1




    Dim lft%, Rite%, Btm%, Tp%
    Dim LftLine%, BtmLine%

        'Determine style of outline
    Select Case FrameStyle
        Case 0                  'Raised
            LftLine = 15
            BtmLine = 0
        Case 1                  'Sunken
            LftLine = 0
            BtmLine = 15
    End Select

        'Calculate coordinates of outline
    lft = TargetControl.Left
    Rite = TargetControl.Left + TargetControl.Width
    Tp = TargetControl.Top
    Btm = TargetControl.Top + TargetControl.Height
    TargetControl.Parent.DrawWidth = FrameWidth

        'Draw Top line
    TargetControl.Parent.Line (lft, Tp)-(Rite, Tp), QBColor(LftLine)
        'Draw Left line
    TargetControl.Parent.Line (lft, Tp)-(lft, Btm), QBColor(LftLine)
        'Draw Bottom line
    TargetControl.Parent.Line (lft, Btm)-(Rite, Btm), QBColor(BtmLine)
        'Draw Right Line
    TargetControl.Parent.Line (Rite, Tp)-(Rite, Btm), QBColor(BtmLine)


End Sub

Sub Form_Paint ()

    DrawFrame TxtValue, 2, 1
    DrawFrame TxtMin, 2, 1
    DrawFrame TxtMax, 2, 1

End Sub

Sub Form_Unload (Cancel As Integer)
    About.Show
End Sub

Sub txtMax_KeyPress (keyascii As Integer)
    If keyascii < Asc("0") Or keyascii > Asc("9") Then
        keyascii = 0            ' cancel the character
        Beep                    ' sound error signal
    End If
End Sub

Sub txtMax_LostFocus ()
    If TxtMax.Text = "" Then
        TxtMax.SetFocus
        sMsg = "Please enter a Maximum value."
        MsgBox sMsg, 64, "Error"
        sMsg = ""
        Exit Sub
    End If

    If Val(TxtMax.Text) <= Val(TxtMin.Text) Then
        TxtMax.SetFocus
        sMsg = "Maximum value must be greater than minimum value."
        MsgBox sMsg, 64, "Error"
        sMsg = ""
        Exit Sub
    End If

    If Val(TxtMax.Text) <= Val(TxtValue.Text) + Val(TxtMin.Text) Then
        TxtMax.SetFocus
        sMsg = "Range must be larger than the number of values generated."
        MsgBox sMsg, 64, "Error"
        sMsg = ""
        Exit Sub
    End If

    If Val(TxtMax.Text) >= 32767 Then
        sMsg = "Number must be less than 32,767."
        Beep
        MsgBox sMsg, 64, "Error"
        TxtMax.SetFocus
        sMsg = ""
        Exit Sub
    End If
End Sub

Sub txtMin_KeyPress (keyascii As Integer)
    If keyascii < Asc("0") Or keyascii > Asc("9") Then
        keyascii = 0            ' cancel the character
        Beep                    ' sound error signal
    End If
End Sub

Sub txtMin_LostFocus ()
    If TxtMin.Text = "" Then
        TxtMin.SetFocus
        sMsg = "Please enter a Minimum value."
        MsgBox sMsg, 64, "Error"
        sMsg = ""
        Exit Sub
    End If

    If Val(TxtMin.Text) >= 32767 Then
        sMsg = "Number must be less than 32,767."
        Beep
        MsgBox sMsg, 64, "Error"
        TxtMin.SetFocus
        sMsg = ""
        Exit Sub
    End If
End Sub

Sub txtValue_KeyPress (keyascii As Integer)
    If keyascii < Asc("0") Or keyascii > Asc("9") Then
        keyascii = 0            ' cancel the character
        Beep                    ' sound error signal
    End If
End Sub

Sub txtValue_LostFocus ()
    If TxtValue.Text = "" Then
        TxtValue.SetFocus
        sMsg = "Please enter a number of values to generate."
        MsgBox sMsg, 64, "Error"
        sMsg = ""
        Exit Sub
    End If
End Sub